home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1995 May / cd Ware (Juegos) Epimundo.iso / DOS / PRGMMING / M2PROTOS.ZIP / QCKERMIT.MOD < prev    next >
Encoding:
Modula Implementation  |  1991-01-21  |  22.7 KB  |  625 lines

  1. (*# call(o_a_copy => off) *)
  2. (*%F _fdata *)
  3. (*# call(seg_name => null) *)
  4. (*%E *)
  5. (*# module(implementation=>on) *)
  6. (*# data(seg_name => null) *)
  7. IMPLEMENTATION MODULE QCkermit;
  8.  
  9.                      (* This JPI Modula-2 module is part of *)
  10.  
  11.                       (* QC -- a communications program *)
  12.                              (* by Carl Neiburger *)
  13.                               (* 169 N. 25th St.*)
  14.                           (* San Jose, Calif. 95116 *)
  15.  
  16.                          (* CompuServe No. 72336,2257 *)
  17.  
  18. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  19. FROM NFIO IMPORT Close, Create, File, OK, Open, PathStr, PathTail, Size, 
  20.     RdChar, WrBin;
  21. FROM Str IMPORT Append, CHARSET, Concat, Copy, Insert, Length;
  22. FROM QCdisp IMPORT DataBytes, DataLeft, DataRegisters, DisplayData, Errs, 
  23.     PromptForChar, ShowErrorType, ShowFileName, ShowPacketSize, IncrDataBytes, 
  24.     ShowTransferTime, ShowTimeLeft, StartDisplay, StatusMessage, StopDisplay, 
  25.     CloseError, CreateError, OpenError, TimeoutMsg, TimeoutAbortMsg, 
  26.     Kermit, WriteErrorMsg;
  27. FROM Lib IMPORT Fill, Move, SetJmp, LongJmp, LongLabel;
  28. FROM QCkpack IMPORT GetDefinitions, SendDefaults, MyExtControls, PackPtr, 
  29.     RecvBuf, RecvCount, RecvPacket, RecvSeq, RecvType, SendBuf, SendCount, 
  30.     SendPacket, SendPacketType, SendSeq, SendType, PacketSize, CtlChar, 
  31.     TheirDefs, InitDefinitions;
  32. FROM Timer IMPORT StartTimer, ForTransfer, ForPacket;
  33. FROM UTIL IMPORT NUMSET, SBITSET, str2, str3, str6;
  34. FROM PathFind IMPORT ParsePath;
  35.  
  36. CONST
  37.     BUFFERSIZE = 1024;
  38.     QuotedChars = NUMSET{63..96,63+128..96+128};
  39.     ControlChars = CHARSET{0C..37C,177C..237C,377C};
  40.     KAbortMsg = 'Sending files aborted';
  41.     TransferAborted = 'File transfer aborted.';
  42.  
  43. TYPE
  44.     AbortType = (NoSoh, BadSf, NotS, NotSFBZ, NotDZ);
  45.     BreakType = (NoBreak, BX, BZ, BC, BE);
  46.  
  47. VAR
  48.     AbortState : AbortType;
  49.     AbortLbl   : LongLabel;   (* return point for abort exit *)
  50.     BreakState : BreakType;
  51.  
  52. PROCEDURE DisplayErrMsg;
  53. VAR Msg: PathStr;
  54. BEGIN
  55.     Move( RecvBuf, ADR(Msg), RecvCount );
  56.     IF RecvCount < SIZE(Msg) THEN
  57.          Msg[RecvCount] := 0C
  58.     END;
  59.     Insert(Msg, 'Error: ', 0);
  60.     StatusMessage(Msg, TRUE);
  61. END DisplayErrMsg;
  62.  
  63. PROCEDURE BreakAck (Achar : CHAR);
  64. BEGIN (* SEND ACK or NAK *)
  65.     SendPacket( 1, (SendSeq + 1) MOD 64, 'Y', ADR(Achar) );
  66. END BreakAck;
  67.  
  68. PROCEDURE SendKermit( FileList: FilePtr );
  69.  
  70. TYPE
  71.     SendStateType = (SendStart,
  72.                      SendHdr,
  73.                      SendData,
  74.                      SendZPkt,
  75.                      SendBPkt,
  76.                      SendDone,
  77.                      SendAbort);
  78.  VAR
  79.     SendState : SendStateType;
  80.     Data      : PackPtr; (* Where data is stored before being sent *)
  81.     abyte     : SHORTCARD;
  82.     ThisChar, 
  83.     PrevChar  : CHAR;
  84.     Msg       : PathStr;
  85.     FileName  : PathTail;
  86.     ChrLen,
  87.     TCount,                  (* to update DataBytes *)
  88.     MaxOutData,
  89.     RepCount  : CARDINAL;
  90.     BytesToGo : LONGINT;
  91.     WeInitiatedAbort, 
  92.     LastFile  : BOOLEAN;
  93.     FileBuffer : ARRAY [1..BUFFERSIZE] OF CHAR;
  94.     Fi : File;
  95.     SaveStr   : str6;
  96.  
  97. PROCEDURE ResendIt ( Retries : SHORTINT );
  98. (* resends packet; if it gets a nak, it repeats for up to Retries times.  
  99.    If it fails, it sets SendState to Abort. *)
  100. BEGIN
  101.     REPEAT
  102.          INC(DataRegisters[FALSE, Errs]);
  103.          DisplayData( Errs, FALSE );
  104.          SendPacket( SendCount, SendSeq, SendType, SendBuf ); 
  105.          CASE RecvPacket() OF
  106.               'Y': RETURN;
  107.              |'N': IF (RecvSeq = (SendSeq+1) MOD 64) THEN
  108.                         SendSeq := RecvSeq;
  109.                         RETURN
  110.                    ELSE
  111.                         DEC(Retries)
  112.                    END;
  113.              |'E': DisplayErrMsg;
  114.                    SendState := SendAbort;
  115.                    WeInitiatedAbort := FALSE;
  116.                    RETURN;
  117.              |'@': WeInitiatedAbort := TRUE;
  118.                    SendState := SendAbort;
  119.              |'T': DEC(Retries, 2);
  120.              |ELSE DEC(Retries)
  121.          END;
  122.     UNTIL Retries < 1;
  123.     StatusMessage (TimeoutAbortMsg, FALSE);
  124.     SendState := SendAbort;
  125.     WeInitiatedAbort := TRUE;
  126. END ResendIt;
  127.  
  128. PROCEDURE QuotedChar(ch: CHAR; VAR i: CARDINAL): str3;
  129. VAR chrstr: str3; 
  130. BEGIN
  131.     Fill( ADR(chrstr), SIZE(chrstr), 0);
  132.     IF (7 IN SBITSET(ch)) AND (TheirDefs.Bit8Quote <> ' ') THEN
  133.          chrstr[0] :=  TheirDefs.Bit8Quote;
  134.          EXCL( SBITSET(ch), 7 );
  135.          i := 1
  136.     ELSE
  137.          i := 0
  138.     END;
  139.     IF (ch IN ControlChars) THEN
  140.          ch := CHR( SBITSET(ch)/SBITSET(40H));
  141.          chrstr[i] := '#';
  142.          INC(i);
  143.     ELSIF ch IN MyExtControls THEN
  144.          chrstr[i] := '#';
  145.          INC(i);
  146.     END; (* CONTROL QUOTING *)
  147.     chrstr[i] := ch;
  148.     INC(i);
  149.     RETURN chrstr
  150. END QuotedChar;
  151.  
  152. PROCEDURE RepChar(count: CARDINAL): str2;
  153. VAR repstr: str2;
  154. BEGIN
  155.     repstr[0] := TheirDefs.RepChar;
  156.     repstr[1] := CHR(count + 21H); (* cq, to increment counter *)
  157.     RETURN repstr
  158. END RepChar;
  159.  
  160. PROCEDURE SendChar;
  161. BEGIN
  162.     Move(ADR(SaveStr), ADR(Data^[SendCount+1]), ChrLen);
  163.     INC(SendCount, ChrLen);
  164.     SaveStr[0] := 0C;
  165.     PrevChar := ThisChar;
  166.     RepCount := 0
  167. END SendChar;
  168.  
  169. BEGIN (* SendKermit *)
  170.     NEW(Data);
  171.     NEW(RecvBuf);
  172.     InitDefinitions;
  173.     SendState := SendStart;
  174.     BreakState := NoBreak;
  175.     LastFile := FALSE;
  176.     StartDisplay( TRUE, Kermit, FALSE );
  177.     LOOP
  178.          IF SetJmp ( AbortLbl ) <> 0 THEN
  179.               EXIT
  180.          END;
  181.          CASE SendState OF
  182.        SendStart:  SendDefaults( 'S' ); 
  183.                    INC(SendState);
  184.        |SendHdr:   IF SendType = 'S' THEN
  185.                         GetDefinitions;
  186.                         ShowPacketSize(PacketSize);
  187.                         ShowErrorType(TheirDefs.CheckType = '3');
  188.                    END;
  189.                    ShowFileName( FileList^.Name, FALSE );
  190.                    FileName := '*.*';
  191.                    Fi := Open(FileList^.Name);
  192.                    IF (Fi = MAX(CARDINAL)) OR 
  193.                       NOT ParsePath(FileList^.Name, FileName) THEN
  194.                         StatusMessage(OpenError, FALSE);
  195.                         WeInitiatedAbort := TRUE;
  196.                         SendState := SendAbort
  197.                    ELSE
  198.                         Fill( ADR(DataRegisters), SIZE(DataRegisters), 0);
  199.                         BytesToGo := VAL(LONGINT, Size(Fi));
  200.                         DataRegisters[FALSE,DataLeft]:=VAL(LONGCARD,BytesToGo);
  201.                         StartTimer(ForPacket);
  202.                         StartTimer(ForTransfer);
  203.                         ShowTimeLeft( FALSE );
  204.                         SaveStr[0] := 0C; (* Initialize for SendData *);
  205.                         SendPacket( Length(FileName), (SendSeq + 1) MOD 64, 
  206.                              'F', ADR(FileName) );
  207.                         INC(SendState);
  208.                         MaxOutData := PacketSize+30H-ORD(TheirDefs.CheckType);
  209.                         IF PacketSize <= 94 THEN 
  210.                              DEC(MaxOutData, 2)
  211.                         END;
  212.                         PrevChar := RdChar(Fi); (* initialize for SendData *)
  213.                    END;
  214.        |SendData:  SendCount := 0;
  215.                    TCount := 0;
  216.                    RepCount := 0;
  217.                    IF SaveStr[0] > 0C THEN
  218.                         SendChar
  219.                    END;
  220.                    LOOP
  221.                         IF (SendCount >= MaxOutData) OR (BytesToGo = 0) THEN
  222.                              EXIT
  223.                         END;
  224.                         ThisChar := RdChar(Fi);
  225.                         DEC(BytesToGo);
  226.                         INC(TCount);
  227.                         IF (PrevChar=ThisChar) AND (TheirDefs.RepChar>' ') 
  228.                            AND ( BytesToGo  > 0) AND (RepCount < 94) THEN 
  229.                              INC(RepCount);
  230.                         ELSE (* different char *)
  231.                              IF RepCount < 2 THEN
  232.                                   Copy( SaveStr, QuotedChar(PrevChar, ChrLen));
  233.                                   IF RepCount = 1 THEN
  234.                                        Append( SaveStr, SaveStr);
  235.                                        ChrLen := ChrLen * 2
  236.                                   END;
  237.                              ELSE
  238.                                   Concat( SaveStr, RepChar(RepCount), 
  239.                                           QuotedChar(PrevChar, ChrLen));
  240.                                   INC( ChrLen, 2 );
  241.                              END;
  242.                              IF SendCount + ChrLen <= MaxOutData THEN
  243.                                   SendChar
  244.                              ELSE
  245.                                   EXIT
  246.                              END;
  247.                         END; (* different char *)
  248.                    END; (* WHILE Read a char *)
  249.                    IncrDataBytes(TCount, FALSE);
  250.                    DisplayData ( DataBytes, FALSE );
  251.                    IF BytesToGo = 0 THEN 
  252.                         SendState := SendZPkt
  253.                    END;
  254.                    SendPacket( SendCount, (SendSeq + 1) MOD 64, 'D', Data );
  255.                    CASE BreakState OF
  256.                        |BC : EXIT;
  257.                        |BE : SendState := SendAbort;
  258.                              WeInitiatedAbort := TRUE;
  259.                        |BX : SendState := SendZPkt;
  260.                        |BZ : SendState := SendZPkt;
  261.                              LastFile := TRUE;
  262.                    END;
  263.        |SendZPkt:  Close(Fi); (* End of File *)
  264.                    Concat(Msg, 'File ', FileName);
  265.                    IF BreakState = NoBreak THEN
  266.                         Append(Msg, ' sent.');
  267.                    ELSE
  268.                         Append(Msg, ' partly sent.');
  269.                    END;
  270.                    StatusMessage(Msg, FALSE );
  271.                    IF LastFile OR (FileList^.Next = NIL) THEN
  272.                         INC(SendState)
  273.                    ELSE
  274.                         FileList := FileList^.Next;
  275.                         SendState := SendHdr
  276.                    END; (* Get next file  *)
  277.                    IF BreakState = BX THEN 
  278.                         BreakState := NoBreak
  279.                    END;
  280.                    SendPacketType('Z');
  281.                    ShowTransferTime;
  282.        |SendBPkt:  SendPacketType('B'); (* Last file sent *)
  283.                    SendState := SendDone;
  284.  
  285.        |SendDone:  IF BreakState <> NoBreak THEN (* Completed Sending *)
  286.                         StatusMessage(TransferAborted, FALSE);
  287.                    END;
  288.                    EXIT;
  289.  
  290.      |SendAbort:   Close(Fi);
  291.                    IF WeInitiatedAbort THEN
  292.                         StatusMessage(KAbortMsg, FALSE);
  293.                         AbortState := BadSf;
  294.                         SendPacket( Length(KAbortMsg), 0, 'E', ADR(KAbortMsg));
  295.                    ELSE
  296.                         SendPacketType('Y')
  297.                    END;
  298.                    ShowTransferTime;
  299.                    EXIT;
  300.          END; (* CASE of SendState *)
  301.          WHILE (RecvPacket() IN CHARSET{'Q','T'}) OR
  302.           ((RecvSeq <> SendSeq) AND (RecvPacket() IN CHARSET{'Q','T'}))
  303.            AND (SendState <> SendAbort) DO
  304.               ResendIt(10)
  305.          END;
  306.          IF (SendState <> SendAbort) THEN
  307.               CASE RecvType OF
  308.                    'Y': IF RecvCount > 1 THEN
  309.                              CASE CHR(RecvBuf^[1]) OF
  310.                              'X': SendState := SendZPkt;
  311.                             |'Z': SendState := SendZPkt;
  312.                                   LastFile := TRUE;
  313.                              END
  314.                         END;
  315.                   |'N': ResendIt(10);
  316.                   |'R': SendState := SendStart;
  317.                   |'E': DisplayErrMsg;
  318.                         SendState := SendAbort;
  319.                         WeInitiatedAbort := FALSE;
  320.                   ELSE SendState := SendAbort;
  321.                        WeInitiatedAbort := TRUE;
  322.               END
  323.          END
  324.     END; (* LOOP *)
  325.     StopDisplay;
  326.     DISPOSE(RecvBuf);
  327.     DISPOSE(Data);
  328. END SendKermit;
  329.  
  330. PROCEDURE ReceiveKermit( Path, GetFile : ARRAY OF CHAR);
  331. (* If GetFile > 0C, R packet will be sent *)
  332. CONST buffersize = 1280;   (* must be a multiple of 128 *)
  333. TYPE
  334.     RecvStateType = ( RecvGet,
  335.                       RecvStart,
  336.                       RecvHdr,
  337.                       RecvData,
  338.                       RecvDone,
  339.                       RecvAbort);
  340.  
  341. VAR
  342.     RecvState      : RecvStateType;
  343.     ReplaceFile    : BOOLEAN;
  344.     Bit8,
  345.     LastSeqNum     : SHORTCARD;
  346.     Retries        : SHORTINT;
  347.     RCount,
  348.     i, j,
  349.     CharCount      : CARDINAL;
  350.     FileName,
  351.     Msg            : PathStr;
  352.     Fi             : File;
  353.     FileBuffer     : ARRAY [1..BUFFERSIZE] OF CHAR;
  354.  
  355. PROCEDURE SendNak;
  356. BEGIN
  357.     IF Retries > 0 THEN (* Ask for a retransmission *)
  358.          SendPacketType('N');
  359.          INC(DataRegisters[TRUE, Errs]);
  360.          DisplayData( Errs, TRUE );
  361.          DEC(SendSeq);
  362.          DEC(Retries);
  363.     ELSE
  364.          RecvState := RecvAbort;
  365.          StatusMessage(TimeoutMsg, FALSE);
  366.     END;
  367. END SendNak;
  368.  
  369. PROCEDURE Resend;
  370. BEGIN
  371.     IF RecvType = 'T' THEN   (* get it over twice as fast *)
  372.          DEC(Retries)
  373.     END;
  374.     IF Retries > 0 THEN 
  375.          INC(DataRegisters[FALSE, Errs]);
  376.          DisplayData( Errs, FALSE );
  377.          SendPacket( SendCount, SendSeq, SendType, SendBuf ); 
  378.          DEC(Retries)
  379.     ELSE 
  380.          StatusMessage (TimeoutAbortMsg,  FALSE);
  381.          RecvState := RecvAbort;
  382.     END
  383. END Resend;
  384.  
  385. PROCEDURE SetAbort;
  386. VAR ch : CHAR;
  387. BEGIN
  388.     IF RecvState = RecvData THEN
  389.          PromptForChar('Abort (A)ll, (F)ile, (T)ransfer), (Panic)', ch);
  390.     ELSE
  391.          PromptForChar('Abort (A)ll, (Panic)', ch);
  392.     END;
  393.     CASE CAP(ch) OF
  394.          'A': RecvState := RecvAbort;
  395.               BreakState := BE;
  396.         |'F': BreakState := BX;
  397.         |'T': BreakState := BZ;
  398.         |'P': BreakState := BC;
  399.               LongJmp( AbortLbl, MAX(CARDINAL) );  (* TRY to do without this *)
  400.          ELSE BreakState := BE;
  401.     END;
  402. END SetAbort;
  403.  
  404. BEGIN (* ReceiveKermit *)
  405.     NEW(RecvBuf);
  406.     RecvType := ' ';         (* initialize to inconsequential value *)
  407.     ReplaceFile := FALSE;
  408.     InitDefinitions;
  409.     LastSeqNum := 0;
  410.     IF GetFile[0] > 0C THEN
  411.          RecvState := RecvGet;
  412.     ELSE         
  413.          RecvState := RecvStart;
  414.     END;
  415.     BreakState := NoBreak;
  416.     Retries := 10;
  417.     StartDisplay( TRUE, Kermit, TRUE );
  418.     LOOP
  419.          IF SetJmp ( AbortLbl ) <> 0 THEN
  420.               EXIT
  421.          END;
  422.          CASE RecvState OF
  423.      RecvGet: SendDefaults( 'I' );
  424.               CASE RecvPacket() OF
  425.               'Y': GetDefinitions;
  426.                    Concat( Msg, 'Receiving ', GetFile );
  427.                    SendPacket( Length(GetFile), 0, 'R', ADR(GetFile) );
  428.                    INC(RecvState);
  429.    |'N', 'Q', 'T': Resend;
  430.              |'@': SetAbort;
  431.               ELSE
  432.                    IF RecvType = 'E' THEN (* Error Packet *)
  433.                         DisplayErrMsg;
  434.                    END;
  435.                    RecvState := RecvAbort;   (* Abort if not INIT packet *)
  436.                    AbortState := NotS;
  437.               END; (* CASE *)
  438.   |RecvStart: CASE RecvPacket() OF
  439.     'N', 'Q', 'T': Resend;
  440.              |'S': SendDefaults( 'Y' ); 
  441.                    GetDefinitions;     (* Init packet *)
  442.                    SendSeq := 0;
  443.                    INC(RecvState);
  444.                    ShowPacketSize(PacketSize);
  445.                    ShowErrorType(TheirDefs.CheckType = '3');
  446.              |'@': SetAbort;
  447.               ELSE
  448.                    IF RecvType = 'E' THEN (* Error Packet *)
  449.                         DisplayErrMsg;
  450.                    END;
  451.                    RecvState := RecvAbort;   (* Abort if not INIT packet *)
  452.                    AbortState := NotS;
  453.               END; (* CASE *)
  454.     (* Receive FileName; Valid received msg type  : S,Z,F,B *)
  455.     |RecvHdr: CASE RecvPacket() OF 
  456.     'N', 'Q', 'T': Resend;
  457.              |'S': RecvState:= RecvStart;
  458.              |'Z': SendPacketType('N');
  459.              |'B': RecvState := RecvDone;
  460.              |'@': SetAbort;
  461.              |'F': Move(RecvBuf, ADR(FileName), RecvCount);
  462.                    FileName[RecvCount] := 0C;
  463.                    Fill( ADR(DataRegisters), SIZE(DataRegisters), 0);
  464.                    ShowFileName( FileName, TRUE );
  465.                    INC(RecvState);
  466.                    Fi := Create(FileName);
  467.                    IF Fi = MAX(CARDINAL) THEN
  468.                         Msg := 'Error creating file';
  469.                         SendPacket(Length(Msg),(SendSeq+1) MOD 64,'E',ADR(Msg));
  470.                         RecvState := RecvAbort;
  471.                         StatusMessage(CreateError, FALSE)
  472.                    END;
  473.                    SendPacketType('Y');
  474.                    StartTimer(ForPacket);
  475.                    StartTimer(ForTransfer);
  476.              |ELSE (* Not S,F,B,Z packet *)
  477.                    IF RecvType = 'E' THEN (* Error Packet *)
  478.                         DisplayErrMsg;
  479.                    END; 
  480.                    RecvState := RecvAbort;
  481.                    AbortState := NotSFBZ;
  482.              END; (* CASE RecvType *)
  483.    |RecvData: IF RecvPacket() IN CHARSET{'N', 'Q', 'T'} THEN
  484.                    SendNak (* Receive Data -- Valid msg type : D,Z *)
  485.               ELSIF RecvType = '@' THEN
  486.                    SetAbort;
  487.                    CASE BreakState OF
  488.                        |BC : EXIT;
  489.                        |BE : RecvState := RecvAbort;
  490.                        |BX : BreakAck('X');
  491.                              BreakState := NoBreak;
  492.                        |BZ : BreakAck('Z');
  493.                    END;
  494.                    Concat(Msg, ' Receiving file ', FileName );
  495.                    Append(Msg, ' Interrupted');
  496.                    StatusMessage( Msg, FALSE );
  497.               ELSIF LastSeqNum = RecvSeq THEN 
  498.                    SendPacketType('Y')
  499.               ELSE 
  500.                    Retries := 10;
  501.                    LastSeqNum := RecvSeq;
  502.                    CASE RecvType OF
  503.                    'D': i := 1;
  504.                       RCount := 0;
  505.                       WHILE i <= RecvCount DO (* Write Data to file  *)
  506.                         IF (TheirDefs.RepChar <> ' ') 
  507.                           AND (CHR(RecvBuf^[i]) = TheirDefs.RepChar) THEN
  508.                              INC(i);
  509.                              CharCount := ORD(RecvBuf^[i]) - 20H;
  510.                              INC(i);
  511.                         ELSE
  512.                              CharCount := 1
  513.                         END;
  514.                         IF (TheirDefs.Bit8Quote<>' ') AND (* 8th bit quoting *)
  515.                            (CHR(RecvBuf^[i]) = TheirDefs.Bit8Quote) THEN 
  516.                              INC(i);
  517.                              Bit8 := 80H;
  518.                         ELSE
  519.                              Bit8 := 0
  520.                         END;
  521.                         IF RecvBuf^[i] = SHORTCARD(TheirDefs.CntrlQuote) THEN 
  522.                              INC(i); (* control char *)
  523.                              IF RecvBuf^[i] IN QuotedChars THEN 
  524.                                   RecvBuf^[i] := SHORTCARD(
  525.                                      SBITSET(RecvBuf^[i])/SBITSET(40H));
  526.                              END
  527.                         END; (* CONTROL character *)
  528.                         INC(RecvBuf^[i], Bit8);
  529.                         FOR j := 1 TO CharCount DO
  530.                              WrBin( Fi, RecvBuf^[i], 1 )
  531.                         END;
  532.                         IF NOT OK THEN
  533.                              StatusMessage(WriteErrorMsg, FALSE);
  534.                              RecvState := RecvAbort;
  535.                              Msg := WriteErrorMsg;
  536.                              SendPacket( Length(Msg), (SendSeq+1) MOD 64, 
  537.                                        'E', ADR(Msg) );
  538.                              SendPacketType('N');
  539.                         END; (* IO error *)
  540.                         INC(RCount, CharCount);
  541.                         INC(i);
  542.                       END; (* WHILE *)
  543.                       IncrDataBytes(RCount, TRUE);
  544.                       DisplayData ( DataBytes, TRUE );
  545.                       SendPacketType('Y');
  546.                 |'F': DEC( SendSeq ); (* repeat *)
  547.                       SendPacketType('Y');
  548.                 |'Z': Close(Fi); (* End of Incoming File *)
  549.                       ShowTransferTime;
  550.                       IF NOT OK THEN
  551.                           StatusMessage(CloseError, TRUE)
  552.                       END;
  553.                       RecvState := RecvHdr;
  554.                       SendPacketType('Y');
  555.                  ELSE  (* Not D,Z packet *)
  556.                       IF RecvType = 'E' THEN (* Error Packet *)
  557.                              DisplayErrMsg;
  558.                       END;
  559.                       RecvState := RecvAbort; (* Abort if not init packet *)
  560.                       AbortState := NotDZ;
  561.                   END; (* CASE RecvType *)
  562.          END;  (* Got a good packet *)
  563.        |RecvDone: SendPacketType('Y'); (* Completed Receiving *)
  564.                   IF BreakState <> NoBreak THEN
  565.                       StatusMessage(TransferAborted, FALSE);
  566.                   END;
  567.                   EXIT;
  568.       |RecvAbort: Msg := 'Receiving file(s)  aborted';
  569.                   StatusMessage(TransferAborted, FALSE);
  570.                   SendPacket( Length(TransferAborted), 0, 'E', 
  571.                      ADR(TransferAborted) );
  572.                   ShowTransferTime;
  573.                   Close(Fi);
  574.                    EXIT;
  575.              END; (* CASE of RecvState *)
  576.     END; (* LOOP *)
  577.     StopDisplay;
  578.     DISPOSE(RecvBuf)
  579. END ReceiveKermit;
  580.  
  581. PROCEDURE KermitCmd( Cmd: CHAR );
  582. TYPE
  583.     CmdStateType = (CmdInit,
  584.                      CmdSend,
  585.                      CmdDone);
  586. VAR
  587.     CmdState : CmdStateType;
  588.     Retries  : SHORTINT;
  589.  
  590. BEGIN (* KermitCmd *)
  591.     NEW(RecvBuf);
  592.     InitDefinitions;
  593.     CmdState := CmdInit;
  594.     BreakState := NoBreak;
  595.     Retries := 10;
  596.     LOOP
  597.          IF SetJmp ( AbortLbl ) <> 0 THEN
  598.               EXIT
  599.          END;
  600.          CASE CmdState OF
  601.          CmdInit:  SendDefaults( 'I' ); 
  602.         |CmdSend:  GetDefinitions;
  603.                    SendPacket( 1, 0, 'G', ADR(Cmd) );
  604.         |CmdDone:  EXIT;
  605.          END; (* CASE of CmdState *)
  606.          CASE RecvPacket() OF
  607.               'Y': INC(CmdState);
  608.                    Retries := 10;
  609.              |'N': ;
  610.              |'E': DisplayErrMsg;
  611.                    EXIT;
  612.              |'@': Retries := 0;
  613.              |'T': DEC(Retries, 2);
  614.              |ELSE DEC(Retries)
  615.          END;
  616.          IF Retries < 1 THEN
  617.               StatusMessage('Command not acknowledged.', TRUE);
  618.               EXIT
  619.          END;
  620.     END; (* LOOP *)
  621.     DISPOSE(RecvBuf);
  622. END KermitCmd;
  623.  
  624. END QCkermit.
  625.